home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Pocket 6.3 / Pocket DA / DA Source / dInterp.txt < prev    next >
Text File  |  1993-06-25  |  3KB  |  95 lines
  1. ; This file is: dInterp.txt  --  interpreter and compiler
  2. ; Mon Apr 25, 1988 15:11:43 macros
  3. ; Wed Apr 27, 1988 12:30:07 v 1.4
  4. ; Thu Jul 04, 1991 05:20:00 add open control key
  5. ; Sat Aug 08, 1992 19:07:00 add floating point numbers
  6. ; Fri May 28, 1993 22:54:00 add \
  7.  
  8. inKey:    ; ( key.data -- )
  9.     BTST    #0,evtMeta(A0)        ; is the command key down?
  10.     BEQ.S    @0
  11.  
  12.     CMPI.B    #'v',1(PS)        ; is the key 'v'?
  13.     BNE.S    @4            ;   if so then
  14.  
  15.     ADDQ    #2,PS            ; drop the ASCII and ...
  16.     JMP    paste-base(BP)        ; ... interpret from clipboard
  17.  
  18.     @4:    CMPI.B    #'o',1(PS)        ; is the key 'o'?
  19.     BNE.S    @0            ;   if not skip ahead.
  20.  
  21.     ADDQ    #2,PS
  22.     JMP    open-base(BP)        ; get and interpret file
  23.  
  24.     @0:    JSR    TextNormal-base(BP)    ; set font, mode and size
  25.     _ObscureCursor            ; hide the mouse cursor
  26.     JSR    NoCurs-base(BP)        ; erase the cursor
  27.     MOVE    (PS)+,D0        ; retrieve the key data
  28.     CMPI.B    #CR,D0            ; is the character a CR
  29.     BEQ.S    Interpret        ; if so: interpret the line
  30.     
  31.     CMPI.B    #BS,D0            ; is the character a backspace?
  32.     BNE.S    @1
  33.  
  34.     TST.B    Counter            ; rubout the previous character
  35.     BLE.S    @3            ; if count > 0 then
  36.  
  37.     SUBQ.B    #1,Counter         ;   decrement count
  38.     MOVE.B    #BL,0(IS,Counter)    ;   in buffer and ...
  39.     JSR    doDel-base(BP)
  40.     JSR    Space-base(BP)        ;   on terminal
  41.     JSR    doDel-base(BP)
  42.     BRA.S    @3
  43.     
  44.     @1:    CMPI.B    #80,Counter        ; is the buffer full
  45.     BEQ.S    @2            ; then just emit it
  46.  
  47.     MOVE.B    D0,0(IS,Counter.W)    ; stash the char into the buffer
  48.     ADDQ    #1,Counter        ; increment char count
  49.     @2:    JSR    EmitCode-base(BP)    ; emit the character    
  50.     @3: RTS
  51.  
  52. Interpret:    ; interpret a line of code
  53.     JSR    doCR-base(BP)        ; emit the CR
  54.     MOVE.B    #0,1(IS,Counter.W)    ; plant a null in the buffer
  55. Main:    JSR    token-Base(BP)        ; get the next word
  56.     MOVE    Dict,-(PS)        ; push pointer to last name
  57.     JSR    search-Base(BP)        ; find current token in dictionary
  58.     TST    (PS)+            ; found NOT IF,
  59.     BEQ.S    TestNum            ; ... assume its a number
  60.     BCLR    #7,fimmed-base(BP)    ; ELSE, immediate? IF
  61.     BNE.S    GoDo            ; ... do it
  62.     TST.B    fcolon-base(BP)        ; ELSE, compiling? NOT IF,
  63.     BEQ.S    GoDo            ; ... do it
  64.     BCLR    #7,fmacro-base(BP)    ; ELSE, macro? IF
  65.     BNE.S    domc
  66.     JSR    compile-base(BP)    ; ELSE, compile a JSR to it
  67.     BRA.S    Main
  68.   godo:    JSR    execute-base(BP)
  69.     JSR    StkChk-base(BP)
  70.     BRA.S    Main
  71.   domc:    JSR    mcomp-base(BP)
  72.     BRA.S    Main
  73.  
  74.   TestNum:    ; Test the token for integer or floating point numberness.
  75.     JSR    here-base(BP)        ; get the relative address of token
  76.     JSR    number-base(BP)        ; convert it to a value, if posible
  77.     TST    (PS)+            ;  was it?
  78.     BEQ.S    testfloat        ; if not, test for floating point
  79.     TST.B    fcolon-base(BP)        ; else, are you compiling?
  80.     BEQ.S    Main            ; if not, leave it on the stack
  81.     JSR    Literal-base(BP)    ; else, compile it as a literal
  82.     BRA.S    Main            ; then, get on with it
  83.  
  84.     TestFloat:    ; It's not an integer, try floating point.
  85.     BCLR    #7,fneg-base(BP)    ; Is it a negative number?
  86.     BEQ.S    @0
  87.     MOVE.B    #$2D,1(A2)        ; put in a negative sign
  88.     @0:    MOVE.L    A2,-(PS)
  89.     JSR    fnum-base(BP)        ; do the conversion (handles error)
  90.     TST.B    fcolon-base(bp)        ; if compiling, leave ...
  91.     BEQ.S    Main            ; ... it on the stack.
  92.     JSR    flit-base(BP)        ; else flit it
  93.     BRA.S    Main
  94.  
  95. ; ----- Dictionary follows ---------